{--
	- file: FdEval.hs 
	- author: ssword
	-
	- just output 
		- run
	-
--}


module FdEval where

import FdType
import FdParser(do_parse)

import FdHelper
import FdEnv
import FdUtil
import FdArray
import FdString
import FdHash
import FdBuildin

import Data.List
import Data.IORef
import Monad
import Control.Monad.Error


do_run :: String -> IO String
do_run text = do {
    env <- do_init;
	do_eval env text;
}

do_init :: IO Env
do_init = do {
    env <- liftIO $ makeEnv;
    runFineday $ loadFunctions env ( primitives );
    return env;
}

do_eval :: Env -> String -> IO String
do_eval env text = do {
	fmap extractValue $ runFineday $ do {
		exp <- liftThrows $ do_parse text;
		res <- eval env exp;
        case res of
            (Value val) -> 
                return val;
            (Return (Value val)) ->
                return val;
            _ -> 
                return Nil;
	};
}


eval :: Env -> Expr -> Fineday Expr
--many many many many many many many many many many many patterns here

eval env Nop                            = return $ Value Nil

-- Literal 
-- make data initalized
eval env (Literal NilL)                 = return $ Value $ Nil
eval env (Literal (NumberL val))        = return $ Value $ Number $ val
eval env (Literal (BoolL val))          = return $ Value $ Bool $ val

eval env (Literal (ArrayL exps)) = do {
	vals <- mapM (eval env) exps >>= mapM (\(Value val) -> return val);
	new_arr <- fd_new_array vals;
	return $ Value $ new_arr;
}

eval env (Literal (StringL str)) = do {
    new_str <- fd_new_string str;
    return $ Value $ new_str;
}

eval env (Literal (HashL exps)) = do {
	pairs <- forM exps (\(k_exp, v_exp)-> do{ 
        (Value k) <- eval env k_exp;
		(Value v) <- eval env v_exp;
		return (k, v);
	});
	new_hash <- fd_new_hash pairs;
	return $ Value $ new_hash;
}

eval env (Literal (FunctionL paras exp)) = do {
	func <- makeFunc env paras exp;
	return $ Value $ Function func;
}

eval env (Return exp) = do {
	result <- eval env exp; 
	return $ Return result;
}

eval env Break = return $ Break

eval env (Apply expr paras) = do {
	-- the same as -- mapM eval paras >>= (apply $ extractValue $ fetchFunction expr)
	-- so ugly it is, monad is so sucks
	-- evaluated all the paras first and trans Exp -> Val
	evaled_exp <- eval env expr; 
	ps <- mapM (eval env) paras >>= mapM (liftThrows . toVal);
	fn <- fetchFunc env evaled_exp;
	-- i think we can catch this instead of modify every function with a fussy pattern!
	r <- fn ps;
	return $ Value r;
}

--sequence; return the last expr
-- i am not quite sure about this
eval env (Seq exps) = do { 
	--find function declarations first
	(decls, main_exps) <- return $ partition isDefine exps;
	--orz
	runSeq env (decls ++ main_exps); 
}

-- conditional & control follows 
-- monad sucks
eval env (If main_part else_part) = do {
	evaled_conds <- mapM (\(cond, _) -> (eval env cond)) $ main_part;
	exps <- return $ map snd main_part; 
	result <- findM (\(cond@(Value v) , _) -> isNotFalse $ v ) (zip evaled_conds exps);
	case result of
		Just (_, exp) -> eval env exp;
		Nothing -> eval env else_part;
}

eval env (Case exp main_part else_part) = do {
    evaled_exp <- eval env exp;
    evaled_matches <- mapM (\(match, _) -> (eval env match)) $ main_part;
    exps <- return $ map snd main_part;
    result <- findM (\(match, _) -> return $ (match==evaled_exp)) $ (zip evaled_matches exps);
    case result of 
        Just (_, exp) -> eval env exp;
        Nothing -> eval env else_part;
}

eval env self@(While cond exp) = do {
	(Value evaled_cond) <- eval env cond;
	ok <- isNotFalse evaled_cond;
	if ok then do {
		-- if catched a break , return a nil, else iter self
		result <- eval env exp;
		case result of 
			Break ->
				return $ Value $ Nil;
			_ -> 
				eval env self;	
	}
	else
		return $ Value $ Nil
}

-- define & assign -- all about variable -- & array
-- sample: var a=2; var add=funcion() {;}
eval env (Define id exp) = do {
	(Value result) <- eval env exp;
	defineVar env (id, result);
	return $ Value $ result;
}


eval env (Ident id) = do {
	val <- getVar env id;
	return $ Value $ val;
}
-- a=1;
eval env (Assign (Ident id) exp) = do {
	(Value result) <- eval env exp;
	setVar env (id, result);
	return $ Value $ result;
}

-- so brain fucking
eval env (ArrayItem (Ident id) index_exp) = do {
	(Value index) <- eval env index_exp;
	var <- getVar env id;
	val <- (case var of 
		(Hash _)   -> fd_get_hash_elem   [var, index];
		(Array _)  -> fd_get_array_elem  [var, index];
		(String _) -> fd_get_string_elem [var, index];
		_ -> throwError $ TypeErr $ (typeOf var)++" cannot be fecthed");
	return $ Value $ val;
}
-- sample: arr[index]='test';
eval env (Assign (ArrayItem (Ident id) index_exp) exp) = do {
	(Value val)   <- eval env exp;
	(Value index) <- eval env index_exp;
	var <- getVar env id;
	val <- (case var of
		(Hash _)   -> fd_set_hash_elem  [var, index, val];
		(Array _)  -> fd_set_array_elem [var, index, val];
		(String _) -> fd_set_string_elem [var, index, val];
		_ -> throwError $ TypeErr $ (typeOf var)++" cannot be fecthed";);
	return $ Value $ val;
}

-- the catch-all pattern~
--eval _ _ = throwError $ Default "uncaught err"



-------------------------------------------------------------
-- helpers in eval
-------------------------------------------------------------

-- run sequence
-- orz ~ it's imperative!
runSeq env []       = return $ Value $ Nil
runSeq env (exp:[]) = eval env exp 
runSeq env (exp:xs) = do {
	result <- eval env exp;
	case result of 
		Break -> 
			return $ Break;
		Return exp -> do {
			result <- eval env exp;
			return $ Return $ result;
		}
		_ -> 
			runSeq env xs;	
}


--about apply -- all about functions , calling , or transform

fetchFunc :: Env -> Expr -> Fineday Func
fetchFunc env (Ident fn) = do {
		var <- getVar env fn;
		case var of
			(Function func) -> return func;
			_ -> throwError $ Default $ fn ++ "is not a function: ";
}
fetchFunc _ (Value (Function func)) = 
	return func


makeFunc :: Env -> [Id] -> Expr -> Fineday Func
makeFunc env pnames exp = return (\paras -> do {
	-- make a closure 
	closure <- io $ cloneEnv env;
	if ((length pnames) == (length paras)) then do {
		defineVars closure $ zip pnames paras;
		result <- eval closure exp;
		(case result of 
			(Value  val)         -> return val 
			(Return (Value val)) -> return val
		);
	}
	else throwError $ ParamErr (length paras) (length pnames) 
})  

breakAtBreak  = breakAt isBreak
breakAtReturn = breakAt isReturn

breakAt :: (a -> Bool) -> [a] -> [a]
breakAt cond list = 
	case (findIndex cond list) of
		Just i ->
			take (i+1) list
		Nothing ->
			list

showEnv :: Env -> Fineday ()
showEnv envRef = io $ (do {
		env <- readIORef envRef;
		print (map (\(a,_)-> a) env);
});

